home *** CD-ROM | disk | FTP | other *** search
/ Programmer Plus 2007 / Programmer-Plus-2007.iso / Programming / Microsoft Plateform / Visual Basic 5.0 / Msvb50.ace / msvb50 / MSVB50 / VB / SAMPLES / VISDATA / DFD.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-10-16  |  21.6 KB  |  637 lines
  1. VERSION 5.00
  2. Begin VB.Form frmDFD 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "Data Form Designer"
  5.    ClientHeight    =   3705
  6.    ClientLeft      =   1155
  7.    ClientTop       =   2505
  8.    ClientWidth     =   6930
  9.    HelpContextID   =   2018517
  10.    Icon            =   "DFD.frx":0000
  11.    LinkTopic       =   "Form1"
  12.    LockControls    =   -1  'True
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   3705
  16.    ScaleWidth      =   6930
  17.    ShowInTaskbar   =   0   'False
  18.    StartUpPosition =   1  'CenterOwner
  19.    Begin VB.CommandButton cmdDown 
  20.       Height          =   540
  21.       Left            =   6285
  22.       Picture         =   "DFD.frx":030A
  23.       Style           =   1  'Graphical
  24.       TabIndex        =   16
  25.       Top             =   2295
  26.       UseMaskColor    =   -1  'True
  27.       Width           =   540
  28.    End
  29.    Begin VB.CommandButton cmdUp 
  30.       Height          =   540
  31.       Left            =   6285
  32.       Picture         =   "DFD.frx":0614
  33.       Style           =   1  'Graphical
  34.       TabIndex        =   15
  35.       Top             =   1710
  36.       UseMaskColor    =   -1  'True
  37.       Width           =   540
  38.    End
  39.    Begin VB.CommandButton cmdMoveFields 
  40.       Caption         =   "<"
  41.       BeginProperty Font 
  42.          Name            =   "Tahoma"
  43.          Size            =   9.75
  44.          Charset         =   0
  45.          Weight          =   400
  46.          Underline       =   0   'False
  47.          Italic          =   0   'False
  48.          Strikethrough   =   0   'False
  49.       EndProperty
  50.       Height          =   375
  51.       Index           =   3
  52.       Left            =   2910
  53.       MaskColor       =   &H00000000&
  54.       TabIndex        =   7
  55.       Top             =   2745
  56.       Width           =   495
  57.    End
  58.    Begin VB.CommandButton cmdMoveFields 
  59.       Caption         =   "<<"
  60.       BeginProperty Font 
  61.          Name            =   "Tahoma"
  62.          Size            =   9.75
  63.          Charset         =   0
  64.          Weight          =   400
  65.          Underline       =   0   'False
  66.          Italic          =   0   'False
  67.          Strikethrough   =   0   'False
  68.       EndProperty
  69.       Height          =   375
  70.       Index           =   2
  71.       Left            =   2910
  72.       MaskColor       =   &H00000000&
  73.       TabIndex        =   6
  74.       Top             =   2295
  75.       Width           =   495
  76.    End
  77.    Begin VB.CommandButton cmdMoveFields 
  78.       Caption         =   ">>"
  79.       BeginProperty Font 
  80.          Name            =   "Tahoma"
  81.          Size            =   9.75
  82.          Charset         =   0
  83.          Weight          =   400
  84.          Underline       =   0   'False
  85.          Italic          =   0   'False
  86.          Strikethrough   =   0   'False
  87.       EndProperty
  88.       Height          =   375
  89.       Index           =   1
  90.       Left            =   2910
  91.       MaskColor       =   &H00000000&
  92.       TabIndex        =   5
  93.       Top             =   1845
  94.       Width           =   495
  95.    End
  96.    Begin VB.CommandButton cmdMoveFields 
  97.       Caption         =   ">"
  98.       BeginProperty Font 
  99.          Name            =   "Tahoma"
  100.          Size            =   9.75
  101.          Charset         =   0
  102.          Weight          =   400
  103.          Underline       =   0   'False
  104.          Italic          =   0   'False
  105.          Strikethrough   =   0   'False
  106.       EndProperty
  107.       Height          =   375
  108.       Index           =   0
  109.       Left            =   2910
  110.       MaskColor       =   &H00000000&
  111.       TabIndex        =   4
  112.       Top             =   1395
  113.       Width           =   495
  114.    End
  115.    Begin VB.ListBox lstSelected 
  116.       DragIcon        =   "DFD.frx":091E
  117.       Height          =   1650
  118.       Left            =   3510
  119.       TabIndex        =   3
  120.       Top             =   1440
  121.       Width           =   2685
  122.    End
  123.    Begin VB.CommandButton cmdBuildForm 
  124.       Caption         =   "&Build the Form"
  125.       Height          =   375
  126.       Left            =   3330
  127.       MaskColor       =   &H00000000&
  128.       TabIndex        =   8
  129.       Top             =   3225
  130.       Width           =   1695
  131.    End
  132.    Begin VB.ComboBox cboRecordSource 
  133.       Height          =   315
  134.       Left            =   1680
  135.       TabIndex        =   1
  136.       Top             =   480
  137.       Width           =   5010
  138.    End
  139.    Begin VB.ListBox lstAll 
  140.       DragIcon        =   "DFD.frx":0C28
  141.       Height          =   1650
  142.       Left            =   120
  143.       TabIndex        =   2
  144.       Top             =   1440
  145.       Width           =   2685
  146.    End
  147.    Begin VB.TextBox txtFormName 
  148.       Height          =   285
  149.       Left            =   2760
  150.       TabIndex        =   0
  151.       Top             =   120
  152.       Width           =   1830
  153.    End
  154.    Begin VB.CommandButton cmdClose 
  155.       Cancel          =   -1  'True
  156.       Caption         =   "&Close"
  157.       Height          =   375
  158.       Left            =   5115
  159.       MaskColor       =   &H00000000&
  160.       TabIndex        =   9
  161.       Top             =   3225
  162.       Width           =   1695
  163.    End
  164.    Begin VB.Line Line1 
  165.       BorderWidth     =   3
  166.       X1              =   120
  167.       X2              =   6780
  168.       Y1              =   1080
  169.       Y2              =   1080
  170.    End
  171.    Begin VB.Label lblLabels 
  172.       Alignment       =   2  'Center
  173.       Caption         =   "Select a Table/QueryDef from the list or enter a SQL statement."
  174.       Height          =   195
  175.       Index           =   2
  176.       Left            =   1680
  177.       TabIndex        =   14
  178.       Top             =   840
  179.       Width           =   5010
  180.    End
  181.    Begin VB.Label lblLabels 
  182.       AutoSize        =   -1  'True
  183.       Caption         =   "Included Fields: "
  184.       Height          =   195
  185.       Index           =   4
  186.       Left            =   3510
  187.       TabIndex        =   13
  188.       Top             =   1200
  189.       Width           =   1170
  190.    End
  191.    Begin VB.Label lblLabels 
  192.       AutoSize        =   -1  'True
  193.       Caption         =   "RecordSource: "
  194.       Height          =   195
  195.       Index           =   1
  196.       Left            =   105
  197.       TabIndex        =   12
  198.       Top             =   540
  199.       Width           =   1110
  200.    End
  201.    Begin VB.Label lblLabels 
  202.       AutoSize        =   -1  'True
  203.       Caption         =   "Available Fields: "
  204.       Height          =   195
  205.       Index           =   3
  206.       Left            =   120
  207.       TabIndex        =   11
  208.       Top             =   1200
  209.       Width           =   1200
  210.    End
  211.    Begin VB.Label lblLabels 
  212.       AutoSize        =   -1  'True
  213.       Caption         =   "Form Name (w/o Extension): "
  214.       Height          =   195
  215.       Index           =   0
  216.       Left            =   120
  217.       TabIndex        =   10
  218.       Top             =   120
  219.       Width           =   2100
  220.    End
  221. Attribute VB_Name = "frmDFD"
  222. Attribute VB_GlobalNameSpace = False
  223. Attribute VB_Creatable = False
  224. Attribute VB_TemplateDerived = False
  225. Attribute VB_PredeclaredId = True
  226. Attribute VB_Exposed = False
  227. Option Explicit
  228. '>>>>>>>>>>>>>>>>>>>>>>>>
  229. Const FORMCAPTION = "Data Form Designer"
  230. Const BUTTON1 = "&Build the Form"
  231. Const BUTTON2 = "&Close"
  232. Const LABEL1 = "Form Name (w/o Extension):"
  233. Const Label2 = "RecordSource:"
  234. Const LABEL3 = "Select a Table/QueryDef from the list or enter a SQL statement."
  235. Const LABEL4 = "Available Fields:"
  236. Const LABEL5 = "Included Fields:"
  237. Const MSG1 = "Form Name cannot be blank!"
  238. Const MSG2 = "You must enter a RecordSource!"
  239. Const MSG3 = "You must include some Columns!"
  240. Const CTLNAME1 = "&Add"
  241. Const CTLNAME2 = "&Delete"
  242. Const CTLNAME3 = "&Refresh"
  243. Const CTLNAME4 = "&Update"
  244. Const CTLNAME5 = "&Close"
  245. '>>>>>>>>>>>>>>>>>>>>>>>>
  246. Dim mrecRS As Recordset
  247. Private Sub cboRecordSource_Change()
  248.   Set mrecRS = Nothing
  249.   lstAll.Clear
  250.   lstSelected.Clear
  251. End Sub
  252. Private Sub cboRecordSource_Click()
  253.   Call cboRecordSource_LostFocus
  254. End Sub
  255. Private Sub cboRecordSource_LostFocus()
  256.   On Error GoTo RSErr
  257.   Dim i As Integer
  258.   Dim fld As Field
  259.   If Len(cboRecordSource.Text) = 0 Then Exit Sub
  260.   Screen.MousePointer = 11
  261.   If mrecRS Is Nothing Then
  262.     Set mrecRS = gdbCurrentDB.OpenRecordset(cboRecordSource.Text)
  263.     For Each fld In mrecRS.Fields
  264.       lstAll.AddItem fld.Name
  265.     Next
  266.   ElseIf mrecRS.Name <> cboRecordSource.Text Then
  267.     lstAll.Clear
  268.     lstSelected.Clear
  269.     Set mrecRS = gdbCurrentDB.OpenRecordset(cboRecordSource.Text)
  270.     For Each fld In mrecRS.Fields
  271.       lstAll.AddItem fld.Name
  272.     Next
  273.   End If
  274.   If lstAll.ListCount > 0 Then lstAll.ListIndex = 0
  275.   Screen.MousePointer = 0
  276.   Exit Sub
  277. RSErr:
  278.   Screen.MousePointer = 0
  279.   MsgBox Error$
  280. End Sub
  281. Sub cmdBuildForm_Click()
  282.   If Len(txtFormName.Text) = 0 Then
  283.     MsgBox MSG1, 16
  284.     txtFormName.SetFocus
  285.     Exit Sub
  286.   End If
  287.   If Len(cboRecordSource.Text) = 0 Then
  288.     MsgBox MSG2, 16
  289.     Exit Sub
  290.   End If
  291.   If lstSelected.ListCount = 0 Then
  292.     MsgBox MSG3, 16
  293.     Exit Sub
  294.   End If
  295.   BuildForm
  296. End Sub
  297. Sub cmdClose_Click()
  298.   Unload Me
  299. End Sub
  300. Private Sub cmdDown_Click()
  301.   On Error Resume Next
  302.   Dim nItem As Integer
  303.   With lstSelected
  304.     If .ListIndex < 0 Then Exit Sub
  305.     nItem = .ListIndex
  306.     If nItem = .ListCount - 1 Then Exit Sub 'can't move last item down
  307.     'move item down
  308.     .AddItem .Text, nItem + 2
  309.     'remove old item
  310.     .RemoveItem nItem
  311.     'select the item that was just moved
  312.     .Selected(nItem + 1) = True
  313.   End With
  314. End Sub
  315. Private Sub cmdMoveFields_Click(Index As Integer)
  316.   Dim i As Integer
  317.   Select Case Index
  318.     Case 0
  319.       If lstAll.ListIndex < 0 Then Exit Sub
  320.       lstSelected.AddItem lstAll.Text
  321.       i = lstAll.ListIndex
  322.       lstAll.RemoveItem i
  323.       If lstAll.ListCount > 0 Then
  324.         If i > lstAll.ListCount - 1 Then
  325.           lstAll.ListIndex = i - 1
  326.         Else
  327.           lstAll.ListIndex = i
  328.         End If
  329.       End If
  330.       lstSelected.ListIndex = lstSelected.NewIndex
  331.     Case 1
  332.       For i = 0 To lstAll.ListCount - 1
  333.         lstSelected.AddItem lstAll.List(i)
  334.       Next
  335.       lstAll.Clear
  336.       lstSelected.ListIndex = 0
  337.     Case 2
  338.       For i = 0 To lstSelected.ListCount - 1
  339.         lstAll.AddItem lstSelected.List(i)
  340.       Next
  341.       lstSelected.Clear
  342.       lstAll.ListIndex = lstAll.NewIndex
  343.     Case 3
  344.       If lstSelected.ListIndex < 0 Then Exit Sub
  345.       lstAll.AddItem lstSelected.Text
  346.       i = lstSelected.ListIndex
  347.       lstSelected.RemoveItem i
  348.       
  349.       lstAll.ListIndex = lstAll.NewIndex
  350.       If lstSelected.ListCount > 0 Then
  351.         If i > lstSelected.ListCount - 1 Then
  352.           lstSelected.ListIndex = i - 1
  353.         Else
  354.           lstSelected.ListIndex = i
  355.         End If
  356.       End If
  357.   End Select
  358. End Sub
  359. Private Sub cmdUp_Click()
  360.   On Error Resume Next
  361.   Dim nItem As Integer
  362.   With lstSelected
  363.     If .ListIndex < 0 Then Exit Sub
  364.     nItem = .ListIndex
  365.     If nItem = 0 Then Exit Sub  'can't move 1st item up
  366.     'move item up
  367.     .AddItem .Text, nItem - 1
  368.     'remove old item
  369.     .RemoveItem nItem + 1
  370.     'select the item that was just moved
  371.     .Selected(nItem - 1) = True
  372.   End With
  373. End Sub
  374. Sub Form_Load()
  375.   Me.Caption = FORMCAPTION
  376.   cmdBuildForm.Caption = BUTTON1
  377.   cmdClose.Caption = BUTTON2
  378.   lblLabels(0).Caption = LABEL1
  379.   lblLabels(1).Caption = Label2
  380.   lblLabels(2).Caption = LABEL3
  381.   lblLabels(3).Caption = LABEL4
  382.   lblLabels(4).Caption = LABEL5
  383.   GetTableList cboRecordSource, True, False, True
  384. End Sub
  385. Private Sub lstAll_DblClick()
  386.   cmdMoveFields_Click 0
  387. End Sub
  388. Private Sub lstSelected_DblClick()
  389.   cmdMoveFields_Click 3
  390. End Sub
  391. Sub BuildForm()
  392.   On Error GoTo BuildErr
  393.   Dim i As Integer
  394.   Dim sTmp As String
  395.   Dim nNumFlds As Integer
  396.   Dim frmNewForm As VBComponent
  397.   Dim ctlNewControl As VBControl
  398.   Dim nButtonTop As Integer
  399.   Dim bOLEFields As Boolean
  400.   nNumFlds = lstSelected.ListCount
  401.   'create the new form
  402.   Set frmNewForm = gVDClass.VBInstance.ActiveVBProject.VBComponents.Add(vbext_ct_VBForm)
  403.   'form height = 320 * numflds + 1260 for buttons and data control
  404.   'form width = 5640
  405.   With frmNewForm
  406.     .Properties!Appearance = 1
  407.     .Properties!Caption = Left(mrecRS.Name, 32)
  408.     .Properties!Height = 1115 + (nNumFlds * 320)
  409.     .Properties!Left = 1050
  410.     .Properties!Name = "frm" & txtFormName.Text
  411.     .Properties!Width = 5640
  412.   End With
  413.   'labels.left = 120, .width = 1815, .height = 255
  414.   'fields.left = 2040, .width = 3375, .height = 285
  415.   For i = 0 To nNumFlds - 1
  416.     sTmp = lstSelected.List(i)
  417.     Set ctlNewControl = frmNewForm.Designer.ContainedVBControls.Add("Label", Nothing)
  418.     With ctlNewControl
  419.       .Properties!Appearance = 1
  420.       .Properties!Caption = sTmp & ":"
  421.       .Properties!Height = 255
  422.       .Properties!Index = i
  423.       .Properties!Left = 120
  424.       .Properties!Name = "lblLabels"
  425.       .Properties!Top = (i * 320) + 60
  426.       .Properties!Width = 1815
  427.     End With
  428.     If mrecRS.Fields(sTmp).Type = 1 Then
  429.       'true/false field
  430.       Set ctlNewControl = frmNewForm.Designer.ContainedVBControls.Add("CheckBox", Nothing)
  431.       With ctlNewControl
  432.         .Properties!Appearance = 1
  433.         .Properties!Caption = ""
  434.         .Properties!Height = 285
  435.         .Properties!Left = 2040
  436.         .Properties!Name = "chkFields"
  437.         .Properties!Top = (i * 320) + 40
  438.         .Properties!Width = 3375
  439.         .Properties!DataSource = "Data1"
  440.         .Properties!DataField = sTmp
  441.       End With
  442.     ElseIf mrecRS.Fields(sTmp).Type = 11 Then
  443.       'picture field
  444.       bOLEFields = True
  445.       Set ctlNewControl = frmNewForm.Designer.ContainedVBControls.Add("OLE", Nothing)
  446.       With ctlNewControl
  447.         .Properties!Height = 285
  448.         .Properties!Left = 2040
  449.         .Properties!Name = "oleFields"
  450.         .Properties!OLETypeAllowed = 1
  451.         .Properties!Top = (i * 320) + 40
  452.         .Properties!Width = 3375
  453.         .Properties!DataSource = "Data1"
  454.         .Properties!DataField = sTmp
  455.       End With
  456.       SendKeys "{Esc}"
  457.     Else
  458.       Set ctlNewControl = frmNewForm.Designer.ContainedVBControls.Add("TextBox", Nothing)
  459.       With ctlNewControl
  460.         .Properties!Appearance = 1
  461.         .Properties!Left = 2040
  462.         .Properties!Name = "txtFields"
  463.         .Properties!Text = ""
  464.         If mrecRS.Fields(sTmp).Type < 10 Then
  465.           'numeric or date
  466.           .Properties!Width = 1935
  467.         Else
  468.           'string or memo
  469.           .Properties!Width = 3375
  470.         End If
  471.         .Properties!DataSource = "Data1"
  472.         .Properties!DataField = sTmp
  473.         If mrecRS.Fields(sTmp).Type = 10 Then
  474.           .Properties!Height = 285
  475.           .Properties!Top = (i * 320) + 40
  476.           .Properties!MaxLength = mrecRS.Fields(sTmp).Size
  477.         ElseIf mrecRS.Fields(sTmp).Type = 12 Then
  478.           .Properties!Height = 310
  479.           .Properties!Top = (i * 320) + 30
  480.           .Properties!MultiLine = True
  481.           .Properties!ScrollBars = 2
  482.         Else
  483.           .Properties!Height = 285
  484.           .Properties!Top = (i * 320) + 40
  485.         End If
  486.       End With
  487.     End If
  488.   Next
  489.   nButtonTop = ctlNewControl.Properties!Top + 340
  490.   'add the data control and buttons
  491.   Set ctlNewControl = frmNewForm.Designer.ContainedVBControls.Add("Data", Nothing)
  492.   With ctlNewControl
  493.     .Properties!Appearance = 1
  494.     .Properties!Align = 2
  495.     .Properties!Caption = ""
  496.     .Properties!DatabaseName = gdbCurrentDB.Name
  497.     .Properties!Connect = gdbCurrentDB.Connect
  498.     .Properties!RecordSource = cboRecordSource.Text
  499.   End With
  500.   Set ctlNewControl = frmNewForm.Designer.ContainedVBControls.Add("CommandButton", Nothing)
  501.   With ctlNewControl
  502.     .Properties!Appearance = 1
  503.     .Properties!Caption = CTLNAME1
  504.     .Properties!Height = 300
  505.     .Properties!Left = 120
  506.     .Properties!Name = "cmdAdd"
  507.     .Properties!Top = nButtonTop
  508.     .Properties!Width = 975
  509.   End With
  510.   Set ctlNewControl = frmNewForm.Designer.ContainedVBControls.Add("CommandButton", Nothing)
  511.   With ctlNewControl
  512.     .Properties!Appearance = 1
  513.     .Properties!Caption = CTLNAME2
  514.     .Properties!Height = 300
  515.     .Properties!Left = 1200
  516.     .Properties!Name = "cmdDelete"
  517.     .Properties!Top = nButtonTop
  518.     .Properties!Width = 975
  519.   End With
  520.   Set ctlNewControl = frmNewForm.Designer.ContainedVBControls.Add("CommandButton", Nothing)
  521.   With ctlNewControl
  522.     .Properties!Appearance = 1
  523.     .Properties!Caption = CTLNAME3
  524.     .Properties!Height = 300
  525.     .Properties!Left = 2280
  526.     .Properties!Name = "cmdRefresh"
  527.     .Properties!Top = nButtonTop
  528.     .Properties!Width = 975
  529.   End With
  530.   Set ctlNewControl = frmNewForm.Designer.ContainedVBControls.Add("CommandButton", Nothing)
  531.   With ctlNewControl
  532.     .Properties!Appearance = 1
  533.     .Properties!Caption = CTLNAME4
  534.     .Properties!Height = 300
  535.     .Properties!Left = 3360
  536.     .Properties!Name = "cmdUpdate"
  537.     .Properties!Top = nButtonTop
  538.     .Properties!Width = 975
  539.   End With
  540.   Set ctlNewControl = frmNewForm.Designer.ContainedVBControls.Add("CommandButton", Nothing)
  541.   With ctlNewControl
  542.     .Properties!Appearance = 1
  543.     .Properties!Caption = CTLNAME5
  544.     .Properties!Height = 300
  545.     .Properties!Left = 4440
  546.     .Properties!Name = "cmdClose"
  547.     .Properties!Top = nButtonTop
  548.     .Properties!Width = 975
  549.   End With
  550.   'add the code to the form
  551.   frmNewForm.CodeModule.AddFromString BuildFrmCode(bOLEFields)
  552.   'set the form back to defaults
  553.   txtFormName.Text = ""
  554.   cboRecordSource.Text = ""
  555.   'try to set focus back to the form
  556.   Me.SetFocus
  557.   txtFormName.SetFocus
  558.   Exit Sub
  559. BuildErr:
  560.   MsgBox Err.Description
  561. End Sub
  562. Function BuildFrmCode(bOLEFields As Boolean) As String
  563.   Dim sCode As String
  564.   Dim i As Integer
  565.   sCode = "Private Sub cmdAdd_Click()"
  566.   sCode = sCode & vbCrLf & "  Data1.Recordset.AddNew"
  567.   sCode = sCode & vbCrLf & "End Sub"
  568.   sCode = sCode & vbCrLf
  569.   sCode = sCode & vbCrLf & "Private Sub cmdDelete_Click()"
  570.   sCode = sCode & vbCrLf & "  'this may produce an error if you delete the last"
  571.   sCode = sCode & vbCrLf & "  'record or the only record in the recordset"
  572.   sCode = sCode & vbCrLf & "  Data1.Recordset.Delete"
  573.   sCode = sCode & vbCrLf & "  Data1.Recordset.MoveNext"
  574.   sCode = sCode & vbCrLf & "End Sub"
  575.   sCode = sCode & vbCrLf
  576.   sCode = sCode & vbCrLf & "Private Sub cmdRefresh_Click()"
  577.   sCode = sCode & vbCrLf & "  'this is really only needed for multi user apps"
  578.   sCode = sCode & vbCrLf & "  Data1.Refresh"
  579.   sCode = sCode & vbCrLf & "End Sub"
  580.   sCode = sCode & vbCrLf
  581.   sCode = sCode & vbCrLf & "Private Sub cmdUpdate_Click()"
  582.   sCode = sCode & vbCrLf & "  Data1.UpdateRecord"
  583.   sCode = sCode & vbCrLf & "  Data1.Recordset.Bookmark = Data1.Recordset.LastModified"
  584.   sCode = sCode & vbCrLf & "End Sub"
  585.   sCode = sCode & vbCrLf
  586.   sCode = sCode & vbCrLf & "Private Sub cmdClose_Click()"
  587.   sCode = sCode & vbCrLf & "  Unload Me"
  588.   sCode = sCode & vbCrLf & "End Sub"
  589.   sCode = sCode & vbCrLf
  590.   sCode = sCode & vbCrLf & "Private Sub Data1_Error(DataErr As Integer, Response As Integer)"
  591.   sCode = sCode & vbCrLf & "  'This is where you would put error handling code"
  592.   sCode = sCode & vbCrLf & "  'If you want to ignore errors, comment out the next line"
  593.   sCode = sCode & vbCrLf & "  'If you want to trap them, add code here to handle them"
  594.   sCode = sCode & vbCrLf & "  MsgBox ""Data error event hit err:"" & Error$(DataErr)"
  595.   sCode = sCode & vbCrLf & "  Response = 0  'throw away the error"
  596.   sCode = sCode & vbCrLf & "End Sub"
  597.   sCode = sCode & vbCrLf
  598.   sCode = sCode & vbCrLf & "Private Sub Data1_Reposition()"
  599.   sCode = sCode & vbCrLf & "  Screen.MousePointer = vbDefault"
  600.   sCode = sCode & vbCrLf & "  On Error Resume Next"
  601.   sCode = sCode & vbCrLf & "  'This will display the current record position"
  602.   sCode = sCode & vbCrLf & "  'for dynasets and snapshots"
  603.   sCode = sCode & vbCrLf & "  Data1.Caption = ""Record: "" & (Data1.Recordset.AbsolutePosition + 1)"
  604.   sCode = sCode & vbCrLf & "  'for the table object you must set the index property when"
  605.   sCode = sCode & vbCrLf & "  'the recordset gets created and use the following line"
  606.   sCode = sCode & vbCrLf & "  'Data1.Caption = ""Record: "" & (Data1.Recordset.RecordCount * (Data1.Recordset.PercentPosition * 0.01)) + 1"
  607.   sCode = sCode & vbCrLf & "End Sub"
  608.   sCode = sCode & vbCrLf
  609.   sCode = sCode & vbCrLf & "Private Sub Data1_Validate(Action As Integer, Save As Integer)"
  610.   sCode = sCode & vbCrLf & "  'This is where you put validation code"
  611.   sCode = sCode & vbCrLf & "  'This event gets called when the following actions occur"
  612.   sCode = sCode & vbCrLf & "  Select Case Action"
  613.   sCode = sCode & vbCrLf & "    Case vbDataActionMoveFirst"
  614.   sCode = sCode & vbCrLf & "    Case vbDataActionMovePrevious"
  615.   sCode = sCode & vbCrLf & "    Case vbDataActionMoveNext"
  616.   sCode = sCode & vbCrLf & "    Case vbDataActionMoveLast"
  617.   sCode = sCode & vbCrLf & "    Case vbDataActionAddNew"
  618.   sCode = sCode & vbCrLf & "    Case vbDataActionUpdate"
  619.   sCode = sCode & vbCrLf & "    Case vbDataActionDelete"
  620.   sCode = sCode & vbCrLf & "    Case vbDataActionFind"
  621.   sCode = sCode & vbCrLf & "    Case vbDataActionBookMark"
  622.   sCode = sCode & vbCrLf & "    Case vbDataActionClose"
  623.   sCode = sCode & vbCrLf & "  End Select"
  624.   sCode = sCode & vbCrLf & "  Screen.MousePointer = vbHourglass"
  625.   sCode = sCode & vbCrLf & "End Sub"
  626.   sCode = sCode & vbCrLf
  627.   'write the code for the bound OLE client control(s)
  628.   If bOLEFields Then
  629.     sCode = sCode & vbCrLf & "Private Sub oleFields_DblClick(Index As Integer)"
  630.     sCode = sCode & vbCrLf & "  'this is the way to get data into an empty ole control"
  631.     sCode = sCode & vbCrLf & "  'and have it saved back to the table"
  632.     sCode = sCode & vbCrLf & "  oleFields(Index).InsertObjDlg"
  633.     sCode = sCode & vbCrLf & "End Sub" & vbCrLf
  634.   End If
  635.   BuildFrmCode = sCode
  636. End Function
  637.